home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.11 / kickpascal-programme / iff / showiff.p < prev    next >
Text File  |  1995-04-21  |  3KB  |  100 lines
  1. {**********************************************************
  2.  ShowIFF:
  3.           Nachdem auf der Purity 7 ein Beispielprogramm
  4.           für die Benutzung der iff.library  für den PCQ
  5.           war, gibt es jetzt und hier das gleiche für
  6.           KickPascal.
  7.           Das Programm benötigt die iff.library im aktuellen
  8.           libs Verzeichnis und die iff Unit. Die iffunit
  9.           liegt als sourcecode bei und wurde von FRANK BEER
  10.           (GÜNTHERSOFT) programmiert. DANKE Frank!
  11.           cli.i wurde programmiert, um den Umgang mit Para-
  12.           metern zu erleichtern.
  13.  
  14.           Dies ist die Version für die neuen Kickpascal-includes.
  15.           damit das Programm auch mit den alten includefiles läuft
  16.           bitte den Hinweis in Zeile 45 lesen.
  17.  
  18.  
  19.           Viel Spaß wünscht
  20.  
  21.                  Michel of Rogersoft.
  22.  
  23. **********************************************************}
  24.  
  25. PROGRAM ShowIFF;
  26.  
  27. USES intuition,graphics,iff;
  28. FROM windows USES arpfilerequester;
  29.  
  30. {$INCL 'cli.i'} { für das Parameterauslesen }
  31.  
  32. VAR    MyScreen     : p_Screen;STATIC;
  33.        ifffile      : PTR;STATIC;
  34.        count,i      : LONG;STATIC;
  35.        colortable   : ARRAY [0..127] OF WORD;STATIC;
  36.        bmhd         : p_bitmapheader;
  37.        Dateiname    : STRING;STATIC;
  38.  
  39. PROCEDURE Ende;
  40. var ok:boolean;
  41. BEGIN
  42.  IF gfxbase  <> NIL THEN closelibrary(gfxbase);
  43.  IF iffbase  <> NIL THEN closelibrary(iffbase);
  44.  IF MyScreen <> NIL THEN ok:=CloseScreen(MyScreen);
  45.  {** für die alten Kickpascalincludes muß obige Zeile heißen:
  46.  IF MyScreen <> NIL THEN CloseScreen(MyScreen);**}
  47.  IF ifffile  <> NIL THEN closeiff(ifffile);
  48. END;
  49.  
  50.  
  51. PROCEDURE bild_laden(bildname:STRING);
  52.  BEGIN
  53.   AddexitServer(Ende);
  54.   ifffile:=OpenIff(Dateiname);
  55.   IF ifffile = NIL THEN ERROR("Fehler beim öffnen des iff-Files");
  56.   bmhd:=GetBmhd(ifffile);
  57.   If bmhd = NIL THEN ERROR("Kann Bitmapheader nicht finden");
  58.   MyScreen:=Open_Screen(0,0,bmhd^.w,bmhd^.h,bmhd^.nPlanes,0,0,
  59.                         GetviewModes(ifffile),'');
  60.   IF myscreen = NIL THEN ERROR("Kann Screen nicht öffnen !");
  61.   count:=GetColorTab(ifffile,^colortable);
  62.   IF (count>32) THEN count:=32;
  63.   LoadRGB4(^MyScreen^.ViewPort,^colortable,count);
  64.   IF NOT DecodePic(ifffile,^MyScreen^.BitMap) THEN
  65.     Error("Kann Bilddatei nicht Decodieren !");
  66.   REPEAT
  67.   UNTIL((mem[$bfe001] and 64 ) = 0);
  68.   ende;
  69. END; { OF bild_laden }
  70.  
  71. PROCEDURE workbenchstart;
  72.  BEGIN
  73.   Reset(input,"CON:0/0/500/100/ShowIFF V1.00 Coded on 01.03.93 for PURITY");
  74.   output:=input;
  75.   WRITELN(CHR($9b),"31;42m","ShowIFF",CHR($9b),"31;40m © by Günthersoft - PD");
  76.   WRITELN('          Überarbeitet 6.12.92/01.03.93 by Rogersoft');
  77.   WRITELN;
  78.   Dateiname:=FileReq(NIL,'IFF Datei wählen');
  79.   IF dateiname<>'' THEN bild_laden(dateiname);
  80.   Close(input);
  81.  END;
  82.  
  83. PROCEDURE clistart;
  84.  BEGIN
  85.   WRITELN(CHR($9b),"31;42m","ShowIFF",CHR($9b),"31;40m © by Günthersoft - PD");
  86.   WRITELN('          Überarbeitet 6.12.92/01.03.93 by Rogersoft');
  87.   WRITELN;
  88.   IF (argnum<1) THEN Writeln ('Kein Parameter übergeben')
  89.    ELSE
  90.    BEGIN
  91.     dateiname:=Getarg(1);
  92.     bild_laden(dateiname);
  93.    END;
  94. END;
  95.  
  96. BEGIN { Hauptprogramm }
  97.  IF FROMWB THEN workbenchstart ELSE clistart;
  98. END.
  99.  
  100.